package clreq;

use strict;
use C_client2;
use File::Basename;
use Sys::Hostname;
use POSIX qw(mkfifo);
use POSIX ":sys_wait_h";
use Data::Dumper;

my $error_rc=0;
my $error_msg=undef;

sub logit {
my $self=shift;
my $type=shift;
my $cline;
my $xx;

	return if !defined($self->{logger});
	for $cline (@_) {
		my @F=split(/\n/,$cline);
		for $xx (@F) {
			$self->{logger}->msg($type,$xx);
		}
	}
}

sub msg {
my $self=shift;

	logit($self,"msg",@_);
}

sub warning {
my $self=shift;

	logit($self,"warn",@_);
}

sub error {
my $self=shift;
my $rc;

	if(scalar(@_)>1) {
		my $x=scalar(@_)-1;
		$rc=$_[$x];
		@_=@_[0 .. $x-1];
	}
	logit($self,"error",@_);
	exit($rc) if defined($rc);
}

#########################################################################
# If array return return code and error string, otherwise just the RC.	#
#########################################################################

sub get_error {
	if(wantarray) {
		return($error_rc,$error_msg);
	}
	return $error_rc;
}

#########################################################################
# Args are:								#
# hosts		Reference to list of hosts to query.			#
# clreqdxml	clreqdxml object to use for host information.		#
# [encryption]	Whether to use Key or rsa based encryption.		#
# [parallel]	Spwan processes for each host or run sequentially.	#
#		Default is sequential. Change to 0 or 1.		#
# [logger]	Logger object for logging messages.			#
# [timeout]     Timeout for connect - default is 10.			#
#########################################################################

sub new {
my $self;
my $class=shift;
my %args=@_;

	$error_rc=0;
	$error_msg=undef;
	if(!exists($args{parallel})) { $args{parallel}=0; }
	if(!exists($args{timeout})) { $args{timeout}=10; }
	if(!exists($args{encryption})) {
		$args{encryption}="rsa";
	} else {
		$args{encryption}=lc($args{encryption});
		if($args{encryption} ne "rsa" && $args{encryption} ne "key") {
			$error_rc=3;
			$error_msg="Encryption type must be 'rsa' or 'key'.";
			return undef;
		}
	}

	if(!exists($args{hosts})) {
		$error_rc=1;
		$error_msg="Missing mandatory 'hosts' argument.";
		return undef;
	}
	if(!exists($args{clreqdxml})) {
		$error_rc=1;
		$error_msg="Missing mandatory 'clreqdxml' argument.";
		return undef;
	}
	#################################################################
	# Validate the host list before doing anything else.		#
	#################################################################

	$self={};
	my @HL=$args{clreqdxml}->get_host_list;
	my $chost;
	for $chost (@{$args{hosts}}) {
		if(!scalar(grep {/^$chost$/} @HL)) {
			$error_rc=2;
			$error_msg="Unknown host '$chost' specified.";
			return undef;
		}
	}
	for (qw(hosts clreqdxml parallel encryption timeout)) {
		$self->{$_}=$args{$_};
	}
	if(exists($args{logger})) {
		$self->{logger}=$args{logger};
	} else {
		$self->{logger}=undef;
	}
	bless($self,$class);
	return $self;
}

#########################################################################
# Run a command against the hosts available and return the results. 	#
# Will run in parallel (when supported). If any of the hosts do not	#
# return a result they will still return a value, with undef against	#
# them.									#
# Args are hash with key=cmd, and ref to list of args.			#
#									#
# Result is reference to a hash where key is the hostname, or undef	#
# if another error occured.						#
#									#
# So a typical call might be:						#
# $ref=$obj->run(cmd => ["scan_ports","keep",1]);			#
#									#
# It is possible for the request in question to fork and run in the	#
# background. When this is the case the command will return 		#
# "PID nn [int]".							#
# The routine here should probe every 10 seconds [or int if set] and	#
# return the results when ready. The result is the client never sees	#
# [or has to deal with] the async nature of the request.		#
#									#
#########################################################################

my $reap_count=0;
my %pids=();
sub reap {

	local $!;
	my $child;
	while(($child=waitpid(-1,WNOHANG)) > 0) {
		print "MESG: Child pid=$child\n" if $::DEBUG;
		print "MESG: FO_host=",Dumper(\%::FO_host) if $::DEBUG;
		print "MESG: pids=",Dumper(\%pids) if $::DEBUG;
		if(exists($pids{$child})) {
			$::FO_host{$pids{$child}}=$child;
			delete $pids{$child};
		}
	}
	$SIG{CHLD} = \&reap;
}

#########################################################################
# Below will run the specified commands against the series of nodes.	#
# Arguments:								#
# cmd		Command to run on each node.				#
#		Is a refernece to a list of command,args		#
# [timeout]	Override currently configured timeout setting.		#
# [firstonly]	It set to 1 then it will run all changes in parallel,	#
#		but return the first result, killing the rest of the	#
#		processes.						#
#									#
# Returns:								#
# hashref	A reference to a hash of results, key is node name.	#
#		First word is ERROR if a problem occurs.		#
#########################################################################

#########################################################################
# We use the below function to ensure the parent has recorded details	#
# of the child before the child does any work - otherwise the child	#
# might exit before the parent is ready to handle it.			#
#########################################################################

sub _wait_mailbox_file($) {
my $p=shift;
my $x=0;
	while($x<100) {

		if(-f "$::ENV{TRUECL_CODE}/etc/mailbox/clreqd-$p") {
			unlink("$::ENV{TRUECL_CODE}/etc/mailbox/clreqd-$p");
			print "MESG: Child detected mailbox file $::ENV{TRUECL_CODE}/etc/mailbox/clreqd-$p - and deleting it to continue.\n" if $::DEBUG;
			return;
		}
		$x++;
		select(undef,undef,undef,0.1);
	}
	print "MESG: Child did not find mailxbox file in 10 seconds!\n" if $::DEBUG;
}

sub run {
my $self=shift;
my %args=@_;
my $TT=undef;
my $firstonly=0;
my $sendonly=0;

	if(defined($args{sendonly}) && $args{sendonly}) {
		$sendonly=1;
	}

	#################################################################
	# Delete mailbox processes that were left hanging araound.	#
	#################################################################
	{
		my ($dfd,$cent);
		if(opendir($dfd,"$::ENV{TRUECL_CODE}/etc/mailbox")) {
			while($cent=readdir($dfd)) {
				if($cent =~ /^clreqd-(\d+)$/) {
					my $pid=$1;
					if(defined($pid) && ! kill(0,$pid)) {
						unlink("$::ENV{TRUECL_CODE}/etc/mailbox/$cent");
					}
				}
			}
			closedir($dfd);
		}
	}

	$error_rc=0;
	$error_msg=undef;
	if(!exists($args{cmd})) {
		$error_rc=1;
		$error_msg="Missing mandatory 'cmd' argument.";
		error($self,$error_msg);
		return undef;
	}
	if(exists($args{firstonly})) {
		$firstonly=$args{firstonly};
	}
	if(exists($args{timeout})) {
		$TT=$args{timeout};
	}

	my @ARGS=(@{$args{cmd}});
	my $_cmd=$ARGS[0];
	shift (@ARGS);

	my $_args="";
	while(@ARGS) {
		my ($cmd,$val);

		$cmd=shift(@ARGS);
		$val=shift(@ARGS);
		$val="" if !defined($val);
		$_args.="|$cmd|$val";
	}

	#################################################################
	# Initially handle all requests in a serial nature...		#
	#################################################################

	my $PORT=$self->{clreqdxml}->get_port_value;
	my $PKI;
	if(exists($::ENV{TRUECL_PKI})) {
		$PKI=$::ENV{TRUECL_PKI};
	} else {	
		$PKI=1;
	}

	my $h=hostname;
	if($PKI==1 && ! -f "$::ENV{TRUECL_CFG}/pki/$h.private") {
		warning($self,"RSA PKI Encryption not available since no $h Private key.");
		$PKI=0;
	}

	if(! -f "$::ENV{TRUECL_CFG}/keys/$h.key") {
		if($self->{encryption} eq "key") {
			error($self,"Forced Key encryption and key/window $h.key not found.",1);
		}
	}

	my %results=();
	if($firstonly || $self->{parallel}) {
		%::FO_host=();
		my $sfile="$::ENV{TRUECL_LOG}/.file$$-";
		$::SIG{CHLD}='IGNORE';
		%pids=();
		my ($chost,$fd);
		print "MESG: File template name for parallel work is '$sfile'\n" if $::DEBUG;
		for $chost (@{$self->{hosts}}) {
			my $child=fork();
			error($self,"Can not fork process:\n$!",1) if !defined($child);
			if(!$child) {
				_wait_mailbox_file($$);
				my ($channel);
				my $ips=join(",",$self->{clreqdxml}->get_host_ip_list($chost));
				$channel=new C_client2(PKI=>$PKI,SERVER_INET=>$ips,SERVER_PORT=>$PORT,SERVER_NAME=>$chost);
				if(!defined($channel)) {
					open($fd,">$sfile$chost");
					print $fd "ERROR Unable to communicate to host [Not contactable via any of: $ips]\n";
					close($fd);
					exit(0);
				} 
				if(defined($TT)) {
					$channel->set_params(TIMEOUT => $TT);
				} else {
					$channel->set_params(TIMEOUT => $self->{timeout});
				}
				#########################################################
				# This might result in a PID nn result, in which case	#
				# we need to loop around waiting for it to finish.	#
				#########################################################
				my ($resp,$err)=$channel->send_request("$_cmd$_args",$sendonly);
				if(defined($err)) {
					open($fd,">$sfile$chost");
					print $fd "ERROR $err\n";
					close($fd);
					exit(0);
				}
				my ($pid_ret)=($resp =~ /PID\s+(\d+)/);
				if($pid_ret) {
					my $ctime=time;
					my $ltime; my $tdiff=10;
					if(defined($TT)) {
						$ltime=$ctime+$TT;
						$tdiff=$TT;
					} else {
						$ltime=$ctime+$self->{timeout};
						$tdiff=$self->{timeout};
					}
					while(1) {
						select(undef,undef,undef,10);
						$channel=new C_client2(PKI=>$PKI,SERVER_INET=>$ips,SERVER_PORT=>$PORT,SERVER_NAME=>$chost);
						if(!defined($channel)) {
							open($fd,">$sfile$chost");
							print $fd "ERROR Unable to communicate to host [Not contactable via any of: $ips]\n";
							close($fd);
							exit(0);
						} 
						$channel->set_params(TIMEOUT => $self->{timeout});
						($resp,$err)=$channel->send_request("query_pid|PID|$pid_ret",$sendonly);
						if(defined($err)) {
							open($fd,">$sfile$chost");
							print $fd "ERROR $err\n";
							close($fd);
							exit(0);
						}
						if($resp =~ /^RUNNING/) {
							$channel=undef;
							next;
						}
						my @F=split(/\n/,$resp);
						$resp=join("\n",@F[1 .. $#F]);
						last;
					}
				}
				open($fd,">$sfile$chost");
				print $fd "$resp\n";
				close($fd);
				exit(0);
			} else {
				print "MESG: Forked process '$child' for host '$chost'.\n" if $::DEBUG;
				$pids{$child}=$chost;
				my $fd;
				open($fd,">$::ENV{TRUECL_CODE}/etc/mailbox/clreqd-$child"); close($fd);
			}
		}
		print "MESG: pids 1=",Dumper(\%pids),"\n" if $::DEBUG;

		#########################################################
		# All children spawned so pick up results...		#
		#########################################################

		$::SIG{CHLD}=\&reap;
		my $firstonly_pid=-1;
		my $firstonly_host=undef;
		my $firstonly_host_error=undef;
		my $firstonly_host_error_host=undef;
		while(scalar(keys(%pids)) || scalar(keys(%::FO_host))>0) {
			print "MESG: size_of_pids=",scalar(keys(%pids)),"\n" if $::DEBUG;
			# FO_host is hash - so check/discard elements in turn
			if(%::FO_host) {
				local $SIG{CHLD}='IGNORE';
				my $skip=0;
				for my $chost (keys %::FO_host) {
					my $r;
					$firstonly_host=$chost;
					$firstonly_pid=$::FO_host{$chost};
					if(open($fd,"$sfile$firstonly_host")) {
						my $r=join("",<$fd>); 
						if($r && $r !~ /^ERROR/) {
							chomp $r;
							print "MESG: firstonly_host=$firstonly_host,contents=$r\n" if $::DEBUG;
							$results{$firstonly_host}=$r;
							close($fd);
							$skip=1;
							last;
						}
						$firstonly_host_error=$r;
						$firstonly_host_error_host=$firstonly_host;
					} else {
						print "MESG: ERROR!\n" if $::DEBUG;
					}
					delete $::FO_host{$chost};
				}
				last if $skip;
			}
			select(undef,undef,undef,0.1);
		}
		print "pids=",Dumper(\%pids) if $::DEBUG;
		print "FO_host=",Dumper(\%::FO_host) if $::DEBUG;
	
		if($firstonly) {
			for(keys(%pids)) {
				kill 1 => $_;
			}
			for $chost (sort(@{$self->{hosts}})) {
				unlink("$sfile$chost");
			}
			if(defined($firstonly_host) && exists($results{$firstonly_host})) {
				return {%results};
			}
			if(defined($firstonly_host_error)) {
				%results=();
				$results{$firstonly_host_error_host}=$firstonly_host_error;
				return {%results};
			}
			return {};
		}
		for $chost (sort(@{$self->{hosts}})) {
			if(!open($fd,"$sfile$chost")) {
				$results{$chost}=undef;
			} else {
				my $r=join("",<$fd>); chomp $r;
				$results{$chost}=$r;
				close($fd);
			}
			unlink("$sfile$chost");
		}
		return {%results};
	}

	#################################################################
	# All requests are currently in sequence - despite what 	#
	# parallel says!						#
	#################################################################

	my $chost;
	$::|=1;
	for $chost (@{$self->{hosts}}) {
		my $channel;
		my $ips=join(",",$self->{clreqdxml}->get_host_ip_list($chost));
		$channel=new C_client2(PKI=>$PKI,SERVER_INET=>$ips,SERVER_PORT=>$PORT,SERVER_NAME=>$chost);
		if(!defined($channel)) {
			my $e=C_client2::error_str();
			$e="?Unknown?" if !defined($e);
			$results{$chost}="ERROR CONNECT ERROR: Unable to communicate to host [Not contactable via any of: $ips]\nReason: $e";
			msg($self,"Unable to communicate to host $chost [Not contactable via any of: $ips]");
			next;
		} 
		if(defined($TT)) {
			$channel->set_params(TIMEOUT => $TT);
		} else {
			$channel->set_params(TIMEOUT => $self->{timeout});
		}
		print "Sending: '$_cmd$_args' (sendonly=$sendonly)\n" if $::DEBUG;
		
		my ($resp,$err)=$channel->send_request("$_cmd$_args",$sendonly);
		if(defined($err)) {
			$results{$chost}="ERROR $err";
			warning($self,"Error returned from send_request for $chost:\n$err");
		} else {
			#################################################################
			# Check to see if the result is a PID nn line, and if so	#
			# we need to check for the async results...			#
			#################################################################
			my ($pid_ret)=($resp =~ /PID\s+(\d+)/);
			if($pid_ret) {
				msg($self,"Processing is running as a background process: $pid_ret");
				my $ctime=time;
				my $ltime; my $tdiff=10;
				if(defined($TT)) {
					$ltime=$ctime+$TT;
					$tdiff=$TT;
				} else {
					$ltime=$ctime+$self->{timeout};
					$tdiff=$self->{timeout};
				}
				while(1 && time < $ltime) {
					select(undef,undef,undef,10);
					$channel=new C_client2(PKI=>$PKI,SERVER_INET=>$ips,SERVER_PORT=>$PORT,SERVER_NAME=>$chost);
					if(!defined($channel)) {
						my $e;
						$e="?Unknown?" if !defined($e);
						$results{$chost}="ERROR CONNECT ERROR: Unable to communicate to host [Not contactable via any of: $ips]\nReason: $e";
						last;
					} 
					$channel->set_params(TIMEOUT => $self->{timeout});
					($resp,$err)=$channel->send_request("query_pid|pid|$pid_ret",$sendonly);
					if(defined($err)) {
						$results{$chost}="ERROR $err";
						last;
					}
					if($resp =~ /^RUNNING/) {
						$channel=undef;
						next;
					}
					my @F=split(/\n/,$resp);
					$resp=join("\n",@F[1 .. $#F]);
					$results{$chost}=$resp;
					last;
				}
			} else {
				$results{$chost}=$resp;
			}
		}
	}
 
	return {%results};
}

1;

